{***************************************************************
    SpyGestion  Copyright (C) 2008 Christophe KOALI <nature2gas@gmail.com>
    
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.
    
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
    
    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
    
****************************************************************}
unit modParsingClassIMenuLeft;

interface

uses modParsingClassBase,
     modBaseType,
     Classes,
     sFonctionsChaines,
     SysUtils,
     Windows,
     LibXmlParser;



const
    NB_LINKS_MIN = 10;

type
    TMenuLinkID = (mliErreur,
                   mliApercu,

                   mliBatiments,
                   mliRecherche,
                   mliChantierSpatial,
                   mliDefense,

                   mliRessource,

                   mliFlotte,
                   mliGalaxie,

                   mliMessages,
                   mliStatistiques);

                   
    TLinkMenuAdv = array[TMenuLinkID] of string;

    /////////////////////////////////////////////
    // Parsing du menu à gauche
    TParsingMenuLeft = class(IParsingRedirection)
    private

       //
       // Informations qui vont être extraites
       //

       FLinks      : TLinkMenuAdv;
       FLinksBackup: TLinkMenuAdv;

       FIsCompteCommandant: boolean;

       // Depuis la 0.76d le menu ne se refresh plus
       FDelayRefresh: integer;

       // liste de lien à télécharger sans effectuer de traitement dessus
       FURLToDownloadAsIgnore: TStringList;



       //
       // Variables qui vont aider à se repérer dans la page
       //

       FInLink   : boolean;
       FLaskLink : string;







       function GetNbLinkFound: integer;

       procedure DoDebugMenu(const Msg: string);
       procedure DebugLinksList;

    public
       // en secondes, -1 ou 0 normalement depuis la version 0.77 puisqu'il n'y a plus de frame
       property DelayRefresh: integer read FDelayRefresh;
       property URLToDownloadAsIgnore: TStringList read FURLToDownloadAsIgnore;

       function GetLink(IdLink: TMenuLinkID): string;

       property IsCompteCommandant: boolean read FIsCompteCommandant;





       /////////////////////////////////////////////////////////////////////////
       // Implémentation de IParsingRedirection

        // initialise l'interface
        procedure Initialisation; override;

        // obtient le résultat d'analyse
        function  GetFinalState: TParsingResultState; override;

        procedure SetFullURLFromBase(const BaseLink: string); override;


        // indique le début et la fin
        //procedure OnStart; override;             // lors du DIV d'ouverture  (non transmis)
        //procedure OnTerminated; override;        // lors du DIV de fermeture (non transmis)

        procedure ScanOnStartTag(Sender: TObject; TagName: string; Attributes: TAttrList); override;
        procedure ScanOnEndTag(Sender: TObject; TagName: string); override;
        procedure ScanOnContent(Sender: TObject; Content: string); override;

       //
       /////////////////////////////////////////////////////////////////////////



       
       procedure RestaureBackup;
       procedure SaveToBackup;
       procedure InitLinks;
       
       constructor Create;
       destructor Destroy; override;
    end;


implementation

uses sHTMLFonctions;

////////////////////////////////////////////////////////////////////////////////
// Menu à gauche
////////////////////////////////////////////////////////////////////////////////

procedure TParsingMenuLeft.DoDebugMenu(const Msg: string);
begin
{$IFDEF DEBUG_PARSING}
        DoDebugContent('MenuLeft -> ' + Msg);
{$ENDIF}
end;

procedure TParsingMenuLeft.DebugLinksList;
var i: integer;
begin
{$IFDEF DEBUG_PARSING}
    DoDebugMenu('Links list:');
    for i := ord(low(TLinkMenuAdv)) to ord(high(TLinkMenuAdv)) do begin
       DoDebugMenu(IntToStr(i) + ' = ' + FLinks[TMenuLinkID(i)]);
    end;
    DoDebugMenu('------');
{$ENDIF}
end;


(*
procedure TParsingMenuLeft.OnStart;              // lors du DIV d'ouverture  (non transmis)
begin
    // rien à faire, tout à été fait dans Initialisation
end;

procedure TParsingMenuLeft.OnTerminated;         // lors du DIV de fermeture (non transmis)
begin
    // rien à faire également, la vérification se fera dans GetFinalState
    DebugLinksList;
end;
*)

procedure TParsingMenuLeft.Initialisation;
begin

       //
       // Informations qui vont être extraites
       //

       // peut-être faire le backup ici et restaurer en cas d'erreur ?
       InitLinks;
       //FLinksBackup: TLinkMenuAdv;

       FIsCompteCommandant:= false;

       // Depuis la 0.76d le menu ne se refresh plus
       FDelayRefresh := -1;

       // liste de lien à télécharger sans effectuer de traitement dessus
       FURLToDownloadAsIgnore.Clear;



       //
       // Variables qui vont aider à se repérer dans la page
       //

       FInLink   := false;
       FLaskLink := '';




       FError := false;

end;

function TParsingMenuLeft.GetFinalState: TParsingResultState;
begin
    Result := PRESULT_ECHEC;

    if GetNbLinkFound < NB_LINKS_MIN then begin
       exit;
    end;
    if FError then begin
       exit;
    end;

    Result := NoT(PRESULT_ECHEC);

end;


function TParsingMenuLeft.GetLink(IdLink: TMenuLinkID): string;
begin
    if IdLink = mliErreur then begin
       Result := '';
       exit;
    end;
    Result := FLinks[IdLink];

end;

function TParsingMenuLeft.GetNbLinkFound: integer;
var i: integer;
begin
    Result := 0;

    for i := ord(low(TLinkMenuAdv)) to ord(high(TLinkMenuAdv)) do begin
       if FLinks[TMenuLinkID(i)] <> '' then begin
          Inc(Result);
       end;

    end;

end;

procedure TParsingMenuLeft.ScanOnStartTag(Sender: TObject; TagName: string; Attributes: TAttrList);
var CurrBalise, sTmp: string;
    xPos: integer;
begin

   TagName := lowercase(TagName);

   if TagName = 'a' then begin
      // <a href='overview.php?session=00000' accesskey="u" target='Hauptframe'>Apercu</a>
      FInLink := true;

      CurrBalise := Attributes.Value('target');

      // Tout les liens pointent vers la frame actuelle puisqu'il
      // n'y a plus de frame
      // si par contre elle pointe ailleurs c'est que le lien est
      // inutile
      if CurrBalise <> '' then exit;

      // On pourrait également vérifier l'accesskey
      // Mais on passe directement au lien
      CurrBalise := Attributes.Value('href');

      // Ancienne version (0.76 et avant)
      // overview
      // b_building
      // resources
      // buildings  mode=Forschung
      // buildings.php?session=0000&mode=Flotte
      // flotten1.php?session=0000&mode=Flotte
      // galaxy.php?session=0000
      // buildings.php?session=0000&mode=Verteidigung
      // allianzen.php?session=0000
      // messages.php?session=0000


      // Version 0.77 (11/08/2007)
      // index.php?page=overview&session=0000


      FLaskLink := CurrBalise;
      CurrBalise := lowercase(CurrBalise);

      if pos('overview', CurrBalise) > 0 then begin

         FLinks[mliApercu] := FLaskLink;

      end else if pos('b_building', CurrBalise) > 0 then begin
         FLinks[mliBatiments] := FLaskLink;

      end else if pos('resources', CurrBalise) > 0 then begin
         FLinks[mliRessource] := FLaskLink;

      end else if pos('buildings', CurrBalise) > 0 then begin
         xPos := pos('?', CurrBalise);
         if xPos = 0 then exit;
         System.Delete(CurrBalise, 1, xPos);
         
         if pos('forschung', CurrBalise) > 0 then begin
            FLinks[mliRecherche]      := FLaskLink;

         end else if pos('flotte', CurrBalise) > 0 then begin
            FLinks[mliChantierSpatial] := FLaskLink;

         end else if pos('verteidigung', CurrBalise) > 0 then begin
            FLinks[mliDefense] := FLaskLink;
         end;

      end else if pos('flotten', CurrBalise) > 0 then begin
         FLinks[mliFlotte] := FLaskLink;


      end else if pos('messages', CurrBalise) > 0 then begin
         FLinks[mliMessages] := FLaskLink;

      end else if pos('stat', CurrBalise) > 0 then begin
         FLinks[mliStatistiques] := FLaskLink;


      end else if pos('galaxy', CurrBalise) > 0 then begin
         FLinks[mliGalaxie] := FLaskLink;


      end else if pos('imperium', CurrBalise) > 0 then begin
         // http://beta.ogame.de/game/imperium.php?session=0000&planettype=1
         FIsCompteCommandant := true;

      end;


   end else if TagName = 'img' then begin
      // FURLToDownloadAsIgnore
      CurrBalise := Attributes.Value('src');

      xPos := pos('//', CurrBalise);

      // backup pour conserver l'URL si jamais il faut l'ajouter
      sTmp := CurrBalise;


      if xPos > 0 then begin
         // extrait le nom de serveur car il se peut que le
         // mot gameforge figure dans l'url d'un skin...

         System.Delete(CurrBalise, 1, xPos + 1);


         xPos := pos('/', CurrBalise);

         if xPos > 0 then begin
            System.Delete(CurrBalise, xPos, maxint);

            if pos('gameforge', lowercase(CurrBalise)) > 0 then begin
               FURLToDownloadAsIgnore.Add(sTmp);
            end;
         end;

      end;



   end else if TagName = 'meta' then begin
       CurrBalise := Attributes.Value('http-equiv');

       if SameText('refresh', CurrBalise) then begin
          CurrBalise := Attributes.Value('content');

          // 1800;URL=leftmenu.php?session=0000
          xPos := pos(';', CurrBalise);

          if xPos > 0 then begin
             // TODO: Peut-être sauvegarder l'url ??
             System.Delete(CurrBalise, xPos, maxint);

             try
                FDelayRefresh := StrToIntDef(CurrBalise, -1);
             except
                FDelayRefresh := -1;
             end;
          end;
       end; 
   end;


end;

procedure TParsingMenuLeft.ScanOnEndTag(Sender: TObject; TagName: string);
begin
   TagName := lowercase(TagName);

   if TagName = 'a' then begin
       FInLink := false;
   end;

end;

procedure TParsingMenuLeft.ScanOnContent(Sender: TObject; Content: string);
begin
    // Pour de futur amélioration, on calque le lien en fonction de
    // ce qui est affiché, et plus en fonction du nom de la page
end;









procedure TParsingMenuLeft.SaveToBackup;
var i: integer;
begin
    for i := ord(low(TLinkMenuAdv)) to ord(high(TLinkMenuAdv)) do begin
       FLinksBackup[TMenuLinkID(i)]  := FLinks[TMenuLinkID(i)];
    end;
end;

procedure TParsingMenuLeft.InitLinks;
var i: integer;
begin
    for i := ord(low(TLinkMenuAdv)) to ord(high(TLinkMenuAdv)) do begin
       FLinks[TMenuLinkID(i)]  := '';
    end;

end;

procedure TParsingMenuLeft.RestaureBackup;
var i: integer;
begin
    for i := ord(low(TLinkMenuAdv)) to ord(high(TLinkMenuAdv)) do begin
       FLinks[TMenuLinkID(i)]  := FLinksBackup[TMenuLinkID(i)];
    end;

end;

procedure TParsingMenuLeft.SetFullURLFromBase(const BaseLink: string);
var i: integer;
begin
    inherited;
    
    for i := ord(low(TLinkMenuAdv)) to ord(high(TLinkMenuAdv))do
       FLinks[TMenuLinkID(i)] := sHTML_Get_URL_Lien(BaseLink, FLinks[TMenuLinkID(i)]);

end;


constructor TParsingMenuLeft.Create;
var i: integer;
begin
    inherited Create;


    FURLToDownloadAsIgnore := TStringList.Create;

    InitLinks;
end;

destructor TParsingMenuLeft.Destroy;
begin
    FURLToDownloadAsIgnore.Free;

    inherited Destroy;
end;


end.
